Файл: ExpertSystem2.txt
Дата: 10.04.2014
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12: присвоить ОТСТУП ' '
13:
14: присвоить ФАЙЛ_БЗ ExpertSystem2-db.txt БАЗА_ЗНАНИЙ "[$ТекущийКаталог][ФАЙЛ_БЗ]"
15: если (файл существует $результат [БАЗА_ЗНАНИЙ] )
16: данные загрузить [БАЗА_ЗНАНИЙ]
17: иначе
18: показать сообщение "Необходимо скачать файл [ФАЙЛ_БЗ] с www.gendoc.ru и поместить его в каталог [$ТекущийКаталог]."
19: конец
20:
21: выбрать (ввести меню1 $результат 'Выберите действие:' 'Показать базу знаний;Интерпретировать базу знаний;Добавить правило;Показать граф базы знаний;Выход' )
22: вариант 'Показать базу знаний'
23: Показать_базу_знаний
24: вариант 'Интерпретировать базу знаний'
25: Интерпретировать_базу_знаний
26: вариант 'Добавить правило'
27: Добавить_правило
28: вариант 'Показать граф базы знаний'
29: Показать_граф_базы_знаний
30: конецВыбора
31:
32: если [$ДанныеИзменены]
33: данные сохранить [БАЗА_ЗНАНИЙ]
34: конец
35:
36:
37:
38: функция Интерпретировать_базу_знаний
39: память локальный гипотеза решение_найдено
40:
41: присвоить ПРОТОКОЛ_ВОПРОСОВ {}
42:
43: показать сообщение 'Загадайте животное и откровенно отвечайте на вопросы.'
44: Протокол 'Протокол логического вывода.'
45:
46: Подготовка_к_логическому_выводу
47: присвоить решение_найдено [$ложь]
48:
49: для [ТЕРМИНАЛЬНЫЕ_СЛЕДСТВИЯ]
50: присвоить гипотеза [$объектЦикла]
51: если (Доказать_гипотезу [гипотеза] 0 )
52: присвоить решение_найдено [$истина]
53: присвоить $списокЦикла {}
54: конец
55: следующий
56:
57: Протокол ''
58: Протокол "Отработавшие правила: [ОТРАБОТАВШИЕ_ПРАВИЛА]."
59:
60: если [решение_найдено]
61: показать сообщение "Это [гипотеза]!"
62: иначе
63: показать сообщение 'Решение не найдено.'
64: конец
65:
66: Протокол ''
67: Протокол 'Итоговый протокол.'
68: для [ПРОТОКОЛ_ВОПРОСОВ]
69: Протокол [$ОбъектЦикла]
70: следующий
71: если [решение_найдено]
72: Протокол "Это [гипотеза]!"
73: иначе
74: Протокол 'Решение не найдено.'
75: конец
76: возврат
77:
78: функция Подготовка_к_логическому_выводу
79: список кМножеству ВСЕ_СЛЕДСТВИЯ (факт домен $результат правило <следствие> )
80: список кМножеству ВСЕ_УСЛОВИЯ (список терминальные $результат (факт домен $результат правило <условие> ) )
81: множество разность ТЕРМИНАЛЬНЫЕ_СЛЕДСТВИЯ [ВСЕ_СЛЕДСТВИЯ] [ВСЕ_УСЛОВИЯ]
82: множество разность ТЕРМИНАЛЬНЫЕ_УСЛОВИЯ [ВСЕ_УСЛОВИЯ] [ВСЕ_СЛЕДСТВИЯ]
83: факт сопоставить ВСЕ_ПРАВИЛА r;правило;[?];[?]
84: присвоить ОТРАБОТАВШИЕ_ПРАВИЛА {}
85: возврат
86:
87: функция Доказать_И гипотезы глубина
88: память локальный доказано подцель
89:
90: присвоить доказано [$истина]
91:
92:
93: для [гипотезы]
94: если (память существует $результат "УСТАНОВЛЕНО;[$ОбъектЦикла]" )
95: если [УСТАНОВЛЕНО;[$ОбъектЦикла] == нет
96: присвоить доказано [$ложь]
97: Протокол "[ОТСТУП]Ранее было установлено, что [$ОбъектЦикла] ЛОЖНО."
98: конец
99: конец
100: следующий
101:
102: если [доказано]
103: для [гипотезы]
104: присвоить подцель [$ОбъектЦикла]
105: присвоить доказано (Доказать_гипотезу [подцель] [глубина] )
106: если [доказано]
107: иначе
108: присвоить $списокЦикла {}
109: конец
110: следующий
111: конец
112:
113: присвоить $результат [доказано]
114: возврат
115:
116: функция Доказать_ИЛИ гипотеза глубина
117: память локальный доказано правила список_подцелей
118:
119: присвоить доказано [$ложь]
120: факт сопоставить правила "r;правило;[гипотеза];[?]"
121: для [правила]
122: Протокол "[ОТСТУП]Применение Правила N [$объектЦикла] для '[гипотеза]'."
123: список взять список_подцелей (факт взять $результат [$объектЦикла] ) 4
124: присвоить доказано (Доказать_И [список_подцелей] [глубина] )
125: если [доказано]
126: список сцепить ОТРАБОТАВШИЕ_ПРАВИЛА $ [$объектЦикла]
127: присвоить $списокЦикла {}
128: конец
129: следующий
130:
131: присвоить $результат [доказано]
132: возврат
133:
134: функция Доказать_гипотезу гипотеза глубина
135: память локальный доказано правила вывод
136:
137: увеличить глубина
138: если [глубина] = 1
139: Протокол ''
140: Протокол "([глубина]) ГИПОТЕЗА: [гипотеза]."
141: иначе
142: Протокол "([глубина]) ПОДЦЕЛЬ: [гипотеза]."
143: конец
144:
145: присвоить доказано [$ложь]
146:
147:
148: если (память существует $результат "УСТАНОВЛЕНО;[гипотеза]" )
149: если [УСТАНОВЛЕНО;[гипотеза] == да
150: присвоить доказано [$истина]
151: иначе
152:
153: конец
154: иначе
155:
156: факт сопоставить правила "r;правило;[гипотеза];{}"
157: если [правила]
158: присвоить доказано [$истина]
159: конец
160:
161: если (множество и $результат [ТЕРМИНАЛЬНЫЕ_УСЛОВИЯ] [гипотеза] )
162: присвоить доказано (Запросить_пользователя [гипотеза] )
163: иначе
164:
165: присвоить доказано (Доказать_ИЛИ [гипотеза] [глубина] )
166: конец
167: конец
168: конец
169:
170: если [доказано]
171: присвоить "УСТАНОВЛЕНО;[гипотеза]" да
172: Обработать_ЛИБО [гипотеза]
173: конец
174:
175: если [доказано]
176: присвоить вывод ИСТИНА
177: иначе
178: присвоить вывод ЛОЖЬ
179: конец
180: Протокол "([глубина]) [гипотеза] ===> [вывод]."
181:
182: присвоить $результат [доказано]
183: возврат
184:
185: функция Обработать_ЛИБО гипотеза
186: память локальный список_фактов успешно множество_взаимоисключающих
187:
188: множество и список_фактов \
189: (факт понятие $результат либо ) \
190: (факт понятие $результат [гипотеза] )
191:
192: для [список_фактов]
193: если (множество и $результат [ОТРАБОТАВШИЕ_ПРАВИЛА] [$ОбъектЦикла] ) == {}
194: список сопоставить успешно (факт взять $результат [$ОбъектЦикла] ) "r;либо;[?множество_взаимоисключающих]"
195: если (множество и $результат [множество_взаимоисключающих] [гипотеза] )
196: для (множество разность $результат [множество_взаимоисключающих] [гипотеза] )
197: присвоить "УСТАНОВЛЕНО;[$ОбъектЦикла]" нет
198: Протокол "[ОТСТУП]УСТАНОВЛЕНО, ЧТО НЕ: [$ОбъектЦикла]."
199: следующий
200: список сцепить ОТРАБОТАВШИЕ_ПРАВИЛА $ [$ОбъектЦикла]
201: конец
202: конец
203: следующий
204:
205: возврат
206:
207: функция Запросить_пользователя гипотеза
208: память локальный ответ_пользователя
209:
210: множество разность ТЕРМИНАЛЬНЫЕ_УСЛОВИЯ [ТЕРМИНАЛЬНЫЕ_УСЛОВИЯ] [гипотеза]
211: ввести меню1 ответ_пользователя "[гипотеза]?" 'да;нет;не знаю'
212: если [ответ_пользователя] == ''
213: присвоить ответ_пользователя 'не знаю'
214: конец
215: Протокол "[ОТСТУП]ВОПРОС: [гипотеза]? [ответ_пользователя]."
216: список сцепить ПРОТОКОЛ_ВОПРОСОВ $ " [гипотеза]? [ответ_пользователя]."
217: если [ответ_пользователя] == да
218: присвоить $результат [$истина]
219: иначе
220: присвоить $результат [$ложь]
221: конец
222: возврат
223:
224: функция Протокол текст
225: >[текст]
226: возврат
227:
228:
229:
230: функция Показать_базу_знаний
231: память локальный номер_факта
232: печать '' 'База знаний.' ========= ''
233: присвоить номер_факта 1
234: пока [номер_факта] <= [$количествоФактов]
235: Показать_правило [номер_факта]
236: увеличить номер_факта
237: цикл
238: возврат
239:
240: функция Показать_правило номер
241: память локальный успешно условие следствие условие_текст
242:
243: список сопоставить успешно (факт взять $результат [номер] ) r;правило;[?следствие];[?условие]
244: если [успешно]
245: присвоить условие_текст ''
246: для [условие]
247: если [условие_текст] == ''
248: присвоить условие_текст [$объектЦикла]
249: иначе
250: присвоить условие_текст "[условие_текст] И [$объектЦикла]"
251: конец
252: следующий
253:
254: >Правило N [номер].
255: если [условие] != {}
256: печать "ЕСЛИ [условие_текст]," " ТО [следствие]."
257: иначе
258: >ИЗВЕСТНО, ЧТО [следствие].
259: конец
260: >
261: иначе
262: список сопоставить успешно (факт взять $результат [номер] ) r;либо;[?следствие]
263: если [успешно]
264: строка заменитьПодстроку следствие $ ';' ' ЛИБО '
265: >Правило N [номер].
266: >ЛИБО [следствие].
267: >
268: конец
269: конец
270: возврат
271:
272:
273:
274: функция Добавить_правило
275: память локальный Все_условия_и_следствия Новое_правило условие факт
276:
277: множество или Все_условия_и_следствия \
278: (факт домен $результат правило <условие> ) \
279: (факт домен $результат правило <следствие> )
280: список терминальные Все_условия_и_следствия $
281: список кМножеству Все_условия_и_следствия $
282:
283: данные использовать 2
284: данные новый
285: для [Все_условия_и_следствия]
286: факт добавить \
287: "i;[$ОбъектЦикла];условие 1" \
288: "i;[$ОбъектЦикла];условие 2" \
289: "i;[$ОбъектЦикла];условие 3" \
290: "i;[$ОбъектЦикла];условие 4" \
291: "i;[$ОбъектЦикла];условие 5" \
292: "i;[$ОбъектЦикла];заключение"
293: следующий
294:
295: ввести форма Новое_правило 'Введите правило (Ctrl - подстановка значения из списка):' 'условие 1;условие 2;условие 3;условие 4;условие 5;заключение'
296: данные использовать 1
297:
298: присвоить ОШИБКА ''
299: если (память существует $результат Новое_правило;заключение )
300:
301: присвоить условие {}
302: для 1;2;3;4;5
303: если [Новое_правило;условие [$ОбъектЦикла]
304: множество или условие $ [Новое_правило;условие [$ОбъектЦикла]
305: конец
306: следующий
307: если [условие] == {}
308: строка сцепить ОШИБКА $ 'Условие для правила не определено.'
309: конец
310:
311:
312: если [Новое_правило;заключение]
313: иначе
314: строка сцепить ОШИБКА $ 'Заключение для правила не определено.'
315: конец
316:
317:
318: если (множество и $результат [условие] [Новое_правило;заключение] )
319: строка сцепить ОШИБКА $ 'Заключение правила не может появляться в его условиях.'
320: конец
321: иначе
322: строка сцепить ОШИБКА $ 'Заключение для правила не определено.'
323: конец
324:
325: если [ОШИБКА]
326: показать сообщение "Правило не добавлено: [ОШИБКА]"
327: иначе
328: список присоединить факт "r;правило;[Новое_правило;заключение]" [условие]
329: факт добавить [факт]
330: Показать_правило (факт найти $результат [факт] )
331: конец
332:
333: возврат
334:
335:
336:
337: функция Показать_граф_базы_знаний
338: память локальный начальная_вершина
339:
340: Подготовка_к_логическому_выводу
341: ввести переменная начальная_вершина 'Показать граф для:' [ВСЕ_СЛЕДСТВИЯ]
342: если [начальная_вершина]
343: данные использовать 2
344: данные новый
345: факт добавить s;вершина;обозначение_вершины;координаты_вершины s;ребро;обозначение_вершины_1;обозначение_вершины_2
346: данные использовать 1
347:
348: присвоить ПРОСМОТРЕННЫЕ_ВЕРШИНЫ {} КОЛОНКА 0
349: Построить_И_ИЛИ_дерево [начальная_вершина] 0
350:
351: присвоить ШАГ_РЕШЕТКИ_ШИРИНА 120 ШАГ_РЕШЕТКИ_ВЫСОТА 100
352: присвоить ПОЛОВИНА_ШИРИНЫ_ВЕРШИНЫ 50 ПОЛОВИНА_ВЫСОТЫ_ВЕРШИНЫ 40
353: присвоить ЦВЕТ_ВЕРШИНЫ 15 ЦВЕТ_РЕБРА 1 РАЗМЕР_ТЕКСТА 9
354:
355: данные использовать 2
356: Показать_граф
357: данные использовать 1
358: конец
359: возврат
360:
361: функция Построить_И_ИЛИ_дерево вершина глубина
362: увеличить глубина
363:
364: если (множество и $результат [ПРОСМОТРЕННЫЕ_ВЕРШИНЫ] [вершина] ) == {}
365: множество или ПРОСМОТРЕННЫЕ_ВЕРШИНЫ $ [вершина]
366:
367:
368: данные использовать 2
369: увеличить КОЛОНКА
370: факт добавить "r;вершина;[вершина];{[КОЛОНКА];[глубина]}"
371: данные использовать 1
372:
373: для (факт сопоставить $результат "r;правило;[вершина];[?]" )
374: для (список взять $результат (факт взять $результат [$ОбъектЦикла] ) 4 )
375:
376:
377: данные использовать 2
378: факт добавить "r;ребро;[вершина];[$ОбъектЦикла]"
379: данные использовать 1
380:
381: Построить_И_ИЛИ_дерево [$ОбъектЦикла] [глубина]
382: следующий
383: следующий
384: конец
385: возврат
386:
387: функция Показать_граф
388: память локальный номер_факта Вершина1 Вершина2 Наименование1 Наименование2
389:
390:
391: присвоить $цветЛинии [ЦВЕТ_РЕБРА] $толщинаЛинии 1
392: присвоить номер_факта 1
393: пока [номер_факта] <= [$КоличествоФактов]
394: если (список сопоставить $результат (факт взять $результат [номер_факта] ) "r;ребро;[?Наименование1];[?Наименование2]" )
395: факт сопоставитьСПервым успешно "r;вершина;[Наименование1];[?Вершина1]"
396: факт сопоставитьСПервым успешно "r;вершина;[Наименование2];[?Вершина2]"
397: Рисовать_линию [Вершина1] [Вершина2]
398: конец
399: увеличить номер_факта
400: цикл
401:
402:
403: присвоить $цветЛинии [ЦВЕТ_ВЕРШИНЫ] $цветКисти [ЦВЕТ_ВЕРШИНЫ] $размерТекста [РАЗМЕР_ТЕКСТА]
404: присвоить номер_факта 1
405: пока [номер_факта] <= [$КоличествоФактов]
406: если (список сопоставить $результат (факт взять $результат [номер_факта] ) "r;вершина;[?Наименование1];[?Вершина1]" )
407: Рисовать_вершину [Наименование1] [Вершина1]
408: конец
409: увеличить номер_факта
410: цикл
411: возврат
412:
413: функция Рисовать_вершину наименование вершина
414: память локальный ширина высота ширина0 высота0 ширина1 высота1 ширина2 высота2
415: список сопоставить _ [вершина] "[?ширина];[?высота]"
416: вычислить * ширина0 [ширина] [ШАГ_РЕШЕТКИ_ШИРИНА]
417: вычислить * высота0 [высота] [ШАГ_РЕШЕТКИ_ВЫСОТА]
418: вычислить - ширина1 [ширина0] [ПОЛОВИНА_ШИРИНЫ_ВЕРШИНЫ]
419: вычислить - высота1 [высота0] [ПОЛОВИНА_ВЫСОТЫ_ВЕРШИНЫ]
420: вычислить + ширина2 [ширина0] [ПОЛОВИНА_ШИРИНЫ_ВЕРШИНЫ]
421: вычислить + высота2 [высота0] [ПОЛОВИНА_ВЫСОТЫ_ВЕРШИНЫ]
422: рисовать прямоугольник [ширина1] [высота1] [ширина2] [высота2]
423: рисовать текстВПрямоугольнике [ширина1] [высота1] [ширина2] [высота2] [наименование]
424: возврат
425:
426: функция Рисовать_линию вершина1 вершина2
427: память локальный ширина1 высота1 ширина2 высота2
428: список сопоставить _ [вершина1] "[?ширина1];[?высота1]"
429: список сопоставить _ [вершина2] "[?ширина2];[?высота2]"
430: вычислить * ширина1 $ [ШАГ_РЕШЕТКИ_ШИРИНА]
431: вычислить * высота1 $ [ШАГ_РЕШЕТКИ_ВЫСОТА]
432: вычислить * ширина2 $ [ШАГ_РЕШЕТКИ_ШИРИНА]
433: вычислить * высота2 $ [ШАГ_РЕШЕТКИ_ВЫСОТА]
434: рисовать линия [ширина1] [высота1] [ширина2] [высота2]
435: возврат